home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Amiga Public Domain Connection / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].zip / APDC Disk #025 - Programming Languages (198x)(Amiga Public Domain Connection)(US)[m][WB].adf / Modula-2 / m2 / MenuDemo.MOD < prev    next >
Text File  |  1988-03-15  |  10KB  |  359 lines
  1. (********************************************************************************
  2.  
  3. Name         : MenuDemo.MOD
  4. Version      : 1.0
  5. Purpose      : Demo For Windows With Menus
  6. Author       : ms
  7. Modified     : 27.3.86  14:20  ms
  8.  
  9. ********************************************************************************)
  10.  
  11. MODULE MenuDemo;
  12.  
  13. FROM Terminal   IMPORT WriteString, WriteLn;
  14. FROM SYSTEM     IMPORT ADDRESS, ADR, BYTE, LONG, TSIZE;
  15. FROM System     IMPORT Allocate;
  16. FROM AMIGADos   IMPORT Delay;
  17. FROM AMIGABase  IMPORT ExecBase, ExecOpenLib, LibCall, Regs;
  18.  
  19. CONST CLOSEWINDOW   =   512D;
  20.       MENUPICK      =   256D;
  21.       JAM2          =      1;
  22.       MENUENABLED   =      1D;
  23.       ITEMTEXT      =      2;
  24.       HIGHCOMP      =     64;
  25.       ITEMENABLED   =     16;
  26.       WINDOWCLOSE   =     8D;
  27.       ACTIVATE      =  4096D;
  28.       WINDOWDRAG    =     2D;
  29.       WINDOWDEPTH   =     4D;
  30.       WINDOWSIZING  =     1D;
  31.       BORDERLESS    =  2048D;
  32.       NOCAREREFRESH =131072D;
  33.       CUSTOMSCREEN  =    0FH;
  34.       WBSCREEN      =    01H; 
  35.       HIRES         =  8000H;
  36.       INTERLACE     =    04H;
  37.       RPORTOFFSET   =     25;
  38.       USERPORTOFS   =     43;
  39.       interMenuWidth = 15;
  40. TYPE StringPtr = POINTER TO ARRAY [0..29999] OF CHAR;
  41.      NewWindow = RECORD
  42.                    leftEdge,
  43.                    topEdge,
  44.                    width,
  45.                    height: CARDINAL;
  46.                    detailPen,
  47.                    blockPen: BYTE;
  48.                    IDCMPFlags,
  49.                    flags: LONGINT;
  50.                    firstGadget,
  51.                    checkMark: LONGINT;
  52.                    title: StringPtr;
  53.                    screen,
  54.                    bitMap: ADDRESS;
  55.                    minWidth,
  56.                    minHeight,
  57.                    maxWidth,
  58.                    maxHeight: CARDINAL;
  59.                    type: CARDINAL
  60.                  END;
  61.  
  62.      MsgPort   = RECORD
  63.                    mpNode: ARRAY [0..13] OF BYTE;    (* TSIZE(Node) = 14  *)
  64.                    mpFlags,
  65.                    mpSigBit: BYTE;
  66.                    mpSigTask: ADDRESS;
  67.                    mpMsgList: ARRAY [0..13] OF BYTE  (* TSIZE(List) = 14 *)
  68.                  END;
  69.  
  70.     MenuItemPtr= POINTER TO MenuItem;
  71.      MenuItem  = RECORD
  72.                    nextItem: MenuItemPtr;
  73.                    leftEdge, topEdge, width, height: INTEGER;
  74.                    flags: CARDINAL;
  75.                    mutex: LONGINT;
  76.                    itemFill, selectFill: ADDRESS;
  77.                    command: BYTE;
  78.                    subItem: MenuItemPtr;
  79.                    nextSelect: CARDINAL
  80.                  END;
  81.      MenuPtr   = POINTER TO Menu;
  82.      Menu      = RECORD
  83.                    nextMenu: MenuPtr;
  84.                    leftEdge, topEdge, width, height: INTEGER;
  85.                    flags: CARDINAL;
  86.                    name: StringPtr;
  87.                    firstItem: MenuItemPtr;
  88.                    jazX, jazzY, beatX, beatY: INTEGER
  89.                  END;
  90.      IntuiTextPtr = POINTER TO IntuiText;
  91.      IntuiText = RECORD
  92.                    frontPen, backPen,
  93.                    drawMode: BYTE;
  94.                    leftEdge, topEdge: INTEGER;
  95.                    iTextFont,
  96.                    iText,
  97.                    nextText: ADDRESS
  98.                  END;
  99. (*   dummy types for window data structure *)
  100.  
  101.      Window    = ARRAY [0..63] OF CARDINAL;
  102.  
  103.      WindowPtr = POINTER TO Window;
  104.  
  105. PROCEDURE OpenLibrary(st: ARRAY OF CHAR): LONGINT;
  106. VAR r: Regs;
  107. BEGIN
  108.   r.a[1]:=ADR(st);
  109.   r.d[0]:=0D;
  110.   LibCall(ExecBase(), ExecOpenLib(), r);
  111.   RETURN r.d[0]
  112. END OpenLibrary;
  113.  
  114. VAR nw: NewWindow;
  115.     w: WindowPtr;
  116.     up: POINTER TO MsgPort;
  117.     len: LONGINT;
  118.     i, intuibase, gfxbase: LONGINT;
  119.     st, wt: ARRAY [0..31] OF CHAR;
  120.     t: ARRAY [0..99] OF CHAR;
  121.     menuHead: MenuPtr;
  122.  
  123. PROCEDURE AllocString(VAR p: ADDRESS; st: ARRAY OF CHAR);
  124. VAR i, j: CARDINAL;
  125.     s: StringPtr;
  126. BEGIN
  127.   WHILE (i<=HIGH(st) & (st[i]#0C) DO INC(i) END;
  128.   Allocate(p, i);
  129.   IF p#NIL THEN
  130.     s:=StringPtr(p);
  131.     FOR j:=0 TO i-1 DO s^[i]:=st[i] END;
  132.     s^[i]:=0C;
  133.   END
  134. END AllocString;
  135.    
  136. PROCEDURE OpenWindow(VAR nw: NewWindow): WindowPtr;
  137. VAR r: Regs;
  138. BEGIN
  139.   r.a[0]:=ADR(nw);
  140.   LibCall(intuibase, -204D, r);
  141.   RETURN WindowPtr(r.d[0]);
  142. END OpenWindow;
  143.  
  144. PROCEDURE CloseWindow(w: WindowPtr);
  145. VAR r: Regs;
  146. BEGIN
  147.   r.a[0]:=LONGINT(w);
  148.   LibCall(intuibase, -72D, r);
  149. END CloseWindow;
  150.  
  151. PROCEDURE Move(rP: ADDRESS; x, y: LONGINT);
  152. VAR r: Regs;
  153. BEGIN
  154.   r.a[1]:=rP;
  155.   r.d[0]:=x;
  156.   r.d[1]:=y;
  157.   LibCall(gfxbase, -240D, r);
  158. END Move;
  159.  
  160. PROCEDURE Wait(signalSet: LONGINT);
  161. VAR r: Regs;
  162. BEGIN
  163.   r.d[0]:=signalSet;
  164.   LibCall(ExecBase(), -318D, r);
  165. END Wait;
  166.  
  167. PROCEDURE Text(rP: ADDRESS; VAR st: ARRAY OF CHAR; len: LONGINT);
  168. VAR r: Regs;
  169. BEGIN
  170.   r.a[1]:=rP;
  171.   r.a[0]:=ADR(st);
  172.   r.d[0]:=len;
  173.   LibCall(gfxbase, -60D, r);
  174. END Text;
  175.  
  176. PROCEDURE NewIText(VAR text: ARRAY OF CHAR; left, top: INTEGER): IntuiTextPtr;
  177. VAR newText: IntuiTextPtr;
  178. BEGIN
  179.   text[HIGH(text)]:=0C;
  180.   Allocate(newText, TSIZE(IntuiText));
  181.   WITH newText^ DO
  182.     iText:=ADR(text);
  183.     frontPen:=BYTE(0); backPen:=BYTE(1);
  184.     drawMode:=BYTE(JAM2);
  185.     leftEdge:=left; topEdge:=top;
  186.     iTextFont:=NIL;
  187.     nextText:=NIL
  188.   END;
  189.   RETURN newText
  190. END NewIText;
  191.  
  192. PROCEDURE NewMenu(menuName: StringPtr;
  193.                   menuWidth, menuHeight: INTEGER): MenuPtr;
  194. VAR menu: MenuPtr;
  195. BEGIN
  196.   menuName[HIGH(menuName)]:=0C;
  197.   Allocate(menu, TSIZE(Menu));
  198.   IF menu#NIL THEN
  199.     WITH menu^ DO
  200.       nextMenu:=NIL;
  201.       leftEdge:=0; topEdge:=0;
  202.       width:=menuWidth; height:=menuHeight;
  203.       flags:=MENUENABLED;
  204.       name:=menuName;
  205.       firstItem:=NIL
  206.     END
  207.   END;
  208.   RETURN menu
  209. END NewMenu;
  210.  
  211. PROCEDURE AddMenu(VAR menus: MenuPtr; menuName: StringPtr;
  212.                   menuWidth, menuHeight: INTEGER): MenuPtr;
  213. VAR newmenu: MenuPtr;
  214. BEGIN
  215.   menuName[HIGH(menuName)]:=0C;
  216.   newmenu:=NewMenu(menuName, menuWidth, menuHeight);
  217.   newmenu^.leftEdge:=menus^.leftEdge+menus^.width+interMenuWidth;
  218.   menus^.nextMenu:=newmenu;
  219.   RETURN newmenu
  220. END AddMenu;
  221.  
  222. PROCEDURE NewMenuItem(VAR name: ARRAY OF CHAR;
  223.                       itemWidth, itemHeight: INTEGER): MenuItemPtr;
  224. VAR newItem: MenuItemPtr;
  225.     newText: IntuiTextPtr;
  226. BEGIN
  227.   name[HIGH(name)]:=0C;
  228.   Allocate(newItem, TSIZE(MenuItem));
  229.   newText:=NewIText(name, 0, 1);
  230.   WITH newItem^ DO
  231.     nextItem:=NIL;
  232.     itemFill:=newText;
  233.     leftEdge:=0; topEdge:=0;
  234.     width:=itemWidth; height:=itemHeight;
  235.     flags:=ITEMTEXT + ITEMENABLED + HIGHCOMP;
  236.     mutex:=0;
  237.     selectFill:=NIL;
  238.     command:=BYTE(0);
  239.     subItem:=NIL;
  240.     nextSelect:=0;
  241.   END;
  242.   RETURN newItem
  243. END NewMenuItem;
  244.  
  245. PROCEDURE AddNewMenuItem(VAR menu: MenuPtr; VAR name: ARRAY OF CHAR; 
  246.                          itemWidth, itemHeight: INTEGER): MenuItemPtr;
  247. VAR newItem: MenuItemPtr;
  248. BEGIN
  249.   name[HIGH(name)]:=0C;
  250.   newItem:=NewMenuItem(name, itemWidth, itemHeight);
  251.   menu^.firstItem:=newItem;
  252.   RETURN newItem
  253. END AddNewMenuItem;
  254.  
  255. PROCEDURE AddItem(VAR items: MenuItemPtr; VAR name: ARRAY OF CHAR): MenuItemPtr;
  256. VAR newItem: MenuItemPtr;
  257. BEGIN
  258.   name[HIGH(name)]:=0C;
  259.   newItem:=NewMenuItem(name, items^.width, items^.height);
  260.   newItem^.topEdge:=items^.topEdge+items^.height;
  261.   newItem^.leftEdge:=items^.leftEdge;
  262.   items^.nextItem:=newItem;
  263.   RETURN newItem
  264. END AddItem;
  265.  
  266. PROCEDURE AddNewSubItem(VAR item: MenuItemPtr; VAR name: ARRAY OF CHAR;
  267.                         itemWidth, itemHeight: INTEGER): MenuItemPtr;
  268. VAR newItem: MenuItemPtr;
  269. BEGIN
  270.   name[HIGH(name)]:=0C;
  271.   newItem:=NewMenuItem(name, itemWidth, itemHeight);
  272.   item^.subItem:=newItem;
  273.   newItem^.leftEdge:=item^.width;
  274.   RETURN newItem;
  275. END AddNewSubItem;
  276.  
  277. PROCEDURE SetMenuStrip(w: WindowPtr; m: MenuPtr);
  278. VAR r: Regs;
  279. BEGIN
  280.   r.a[0]:=LONGINT(w);
  281.   r.a[1]:=LONGINT(m);
  282.   LibCall(intuibase, -264D, r)
  283. END SetMenuStrip;
  284.  
  285. PROCEDURE InitMenus(VAR w: WindowPtr);
  286. VAR currentMenu: MenuPtr;
  287.     currentItem, subItem: MenuItemPtr;
  288. BEGIN
  289.   s1:="Modula 2";
  290.   currentMenu    := NewMenu(s1 (*"Modula 2 "*), 100, 10);
  291.   menuHead       := currentMenu;
  292.   s2:="Compiler ";
  293.      currentItem := AddNewMenuItem(currentMenu, s2 (*"Compiler "*), 100, 11);
  294.   s3:="Window";
  295.      currentItem := AddItem(currentItem, s3 (*"Window "*) );
  296.   s4:="to Back";
  297.         subItem  := AddNewSubItem(currentItem, s4 (*"to Back "*), 76, 11);
  298.   s5:="to Front";
  299.         subItem  := AddItem(subItem, s5 (*"to Front "*));
  300.   s6:="Quit";
  301.      currentItem := AddItem(currentItem, s6 (*"Quit "*));
  302.   s7:="Settings";
  303.   currentMenu    := AddMenu(currentMenu, s7 (*"Settings "*), 100, 10);
  304.   s8:="Baud";
  305.      currentItem := AddNewMenuItem(currentMenu, s8 (*"Baud "*), 100, 11);
  306.   s9:="Length";
  307.      currentItem := AddItem(currentItem, s9 (*"Length "*));
  308.  
  309.   SetMenuStrip(w, menuHead);
  310. END InitMenus;
  311.   
  312.  
  313. BEGIN
  314.   st:='intuition.library';
  315.   intuibase:=OpenLibrary(st);
  316.   st:='graphics.library';
  317.   gfxbase:=OpenLibrary(st);
  318.   IF (intuibase=0D) OR (gfxbase=0D) THEN
  319.     WriteString('Error: libraries not opened'); WriteLn
  320.   ELSE
  321.     wt:='A Window With Menus';
  322.     WITH nw DO
  323.       leftEdge:=20;
  324.       topEdge:=20;
  325.       width:=600;
  326.       height:=150;
  327.       detailPen:=BYTE(0);
  328.       blockPen:=BYTE(1);
  329.       IDCMPFlags:=CLOSEWINDOW (* + MENUPICK *);
  330.       flags:=WINDOWCLOSE + ACTIVATE + WINDOWDRAG + WINDOWDEPTH
  331.              + WINDOWSIZING + NOCAREREFRESH;
  332.       firstGadget:=NIL;
  333.       checkMark:=NIL;
  334.       title:=ADR(wt);
  335.       screen:=NIL;
  336.       bitMap:=NIL;
  337.       minWidth:=100;
  338.       minHeight:=25;
  339.       maxWidth:=640;
  340.       maxHeight:=200;
  341.       type:=WBSCREEN 
  342.     END;
  343.     w:=OpenWindow(nw);
  344.  
  345.     IF LONGINT(w)#0D THEN
  346.       InitMenus(w);
  347.       Move(LONG(w^[RPORTOFFSET], w^[RPORTOFFSET+1]), 10D, 20D);
  348.       t:='Hello World'; len:=11D;
  349.       Text(LONG(w^[RPORTOFFSET], w^[RPORTOFFSET+1]), t, len);
  350.  
  351.       up:=ADDRESS(LONG(w^[USERPORTOFS], w^[USERPORTOFS+1]));
  352.       Wait(SHIFT(1D, CARDINAL(up^.mpSigBit)));
  353.     ELSE
  354.       WriteString('Error: OpenWindow not done '); WriteLn
  355.     END;
  356.     CloseWindow(w);
  357.   END;
  358. END MenuDemo.
  359.